home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Snippets / PNL Libraries / MyListManager.p < prev    next >
Text File  |  1997-06-06  |  5KB  |  222 lines
  1. unit MyListManager;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Types, Lists;
  7.         
  8.     type
  9.         LClickSafeProc = function( list: ListHandle; refcon: univ longint ):boolean;
  10.     
  11.     type
  12.         LForEachProcResult = (FEP_Continue, FEP_Stop, FEP_Deleted);
  13.         LForEachProc = function ( list: ListHandle; c: Cell; refcon: longint ): LForEachProcResult;
  14.     
  15.     procedure LForEachSelectedItem( list: ListHandle; proc: LForEachProc; refcon: univ longint );
  16.     function LCount( list: ListHandle ): integer;
  17.     function LCountSelections (list: ListHandle): integer;
  18.     function LHasSelection (list: ListHandle): boolean;
  19.     function LAllSelected( list: ListHandle ): boolean;
  20.     procedure LSetSingleSelection (list: ListHandle; v: integer);
  21.     procedure LSetAllSelections ( list: ListHandle; on: boolean);
  22.     function LPointToCell (list: ListHandle; pt: Point; var c: Cell): boolean;
  23.     function LGetFirstSelection (list: ListHandle; var c: Cell): boolean;
  24.     function LGetLastSelection (list: ListHandle; var c: Cell): boolean;
  25.     function LClickSafe(localPt:Point; modifiers:integer; list:ListRef; proc: LClickSafeProc; refcon: univ longint ):boolean;
  26.  
  27. implementation
  28.  
  29.     uses
  30.         OSUtils, Traps, Quickdraw,
  31.         MyAssertions;
  32.         
  33.     function LCount( list: ListHandle ): integer;
  34.     begin
  35.         LCount := list^^.dataBounds.bottom;
  36.     end;
  37.     
  38.     function LCountSelections (list: ListHandle): integer;
  39.         var
  40.             c: Cell;
  41.             count: integer;
  42.     begin
  43.         count := 0;
  44.         c.h := 0;
  45.         c.v := 0;
  46.         while LGetSelect(true, c, list) do begin
  47.             count := count + 1;
  48.             c.v := c.v + 1;
  49.         end;
  50.         LCountSelections := count;
  51.     end;
  52.  
  53.     function LHasSelection (list: ListHandle): boolean;
  54.         var
  55.             c: Cell;
  56.     begin
  57.         c.h := 0;
  58.         c.v := 0;
  59.         LHasSelection := LGetSelect(true, c, list);
  60.     end;
  61.  
  62.     function LAllSelected( list: ListHandle ): boolean;
  63.         var
  64.             c: Cell;
  65.             i: integer;
  66.     begin
  67.         LAllSelected := true;
  68.         for i := 0 to LCount( list ) - 1 do begin
  69.             c.h := 0;
  70.             c.v := i;
  71.             if not LGetSelect( false, c, list ) then begin
  72.                 LAllSelected := false;
  73.                 leave;
  74.             end;
  75.         end;
  76.     end;
  77.     
  78.     procedure LSetAllSelections ( list: ListHandle; on: boolean);
  79.         var
  80.             i: integer;
  81.             c: Cell;
  82.     begin
  83.         for i := 0 to LCount( list ) - 1 do begin
  84.             c.h := 0;
  85.             c.v := i;
  86.             LSetSelect(on, c, list);
  87.         end;
  88.     end;
  89.  
  90.     procedure LSetSingleSelection (list: ListHandle; v: integer);
  91.         var
  92.             c: Cell;
  93.     begin
  94.         c.h := 0;
  95.         c.v := v;
  96.         LSetSelect(true, c, list);
  97.         c.v := 0;
  98.         c.h := 0;
  99.         while LGetSelect(true, c, list) do begin
  100.             if c.v <> v then begin
  101.                 LSetSelect(false, c, list);
  102.             end;
  103.             c.v := c.v + 1;
  104.             c.h := 0;
  105.         end;
  106.     end;
  107.  
  108.     function LPointToCell (list: ListHandle; pt: Point; var c: Cell): boolean;
  109.     begin
  110.         c.h := 0;
  111.         c.v := -1;
  112.         if PtInRect(pt, list^^.rView) then begin
  113.             c.v := list^^.visible.top + (pt.v - list^^.rView.top) div list^^.cellSize.v;
  114.         end;
  115.         LPointToCell := PtInRect(c, list^^.dataBounds);
  116.     end;
  117.  
  118.     function LGetLastSelection (list: ListHandle; var c: Cell): boolean;
  119.         var
  120.             tmp: integer;
  121.     begin
  122.         LGetLastSelection := false;
  123.         c.h := 0;
  124.         c.v := 0;
  125.         while LGetSelect(true, c, list) do begin
  126.             LGetLastSelection := true;
  127.             tmp := c.v;
  128.             c.v := c.v + 1;
  129.         end;
  130.         c.v := tmp;
  131.     end;
  132.  
  133.     function LGetFirstSelection (list: ListHandle; var c: Cell): boolean;
  134.     begin
  135.         c.h := 0;
  136.         c.v := 0;
  137.         LGetFirstSelection := LGetSelect(true, c, list);
  138.     end;
  139.  
  140.     var
  141.         hack_lclick_proc: LClickSafeProc;
  142.         hack_lclick_list: ListHandle;
  143.         hack_lclick_refcon: longint;
  144.     
  145.     function LClickProc: boolean;
  146.     begin
  147.         LClickProc := hack_lclick_proc( hack_lclick_list, hack_lclick_refcon );
  148.     end;
  149.  
  150. {$IFC not GENERATINGPOWERPC}
  151.  
  152. (*
  153.  *    LClickGlue()
  154.  *
  155.  *    On 68K, an LClickProc needs to return the result in the Z register.
  156.  *    This is pretty hard to do from a 'real' function; so this glue function
  157.  *    calls the 'real' LClickProc() function and then tests the return value
  158.  *    in D0 to set the Z bit based on the return result from the function.
  159.  *)
  160.  
  161.     procedure LClickGlue; asm;
  162.     begin
  163.         CLR.W        -(SP)
  164.         JSR             LClickProc
  165.         MOVE.B        (SP)+, D0
  166.         TST.B        D0
  167.         RTS
  168.     end;
  169.     
  170. {$ENDC}
  171.  
  172.     function LClickSafe(localPt:Point; modifiers:integer; list:ListRef; proc: LClickSafeProc; refcon: univ longint ):boolean;
  173.         var
  174.             savedcl: ProcPtr;
  175.             listClickUPP: UniversalProcPtr;
  176.     begin
  177.         if proc = nil then begin
  178.             LClickSafe := LClick(localPt, modifiers, list);
  179.         end else begin
  180.             hack_lclick_proc := proc;
  181.             hack_lclick_list := list;
  182.             hack_lclick_refcon := refcon;
  183.             savedcl := list^^.lClickLoop;
  184. {$IFC GENERATINGPOWERPC}
  185.             listClickUPP := NewListClickLoopProc( @LClickProc );
  186. {$ELSEC}
  187.             listClickUPP := NewListClickLoopProc( @LClickGlue );
  188. {$ENDC}
  189.             list^^.lClickLoop := listClickUPP;
  190.             LClickSafe := LClick(localPt, modifiers, list);
  191.             list^^.lClickLoop := savedcl;
  192.             hack_lclick_proc := nil;
  193.         end;
  194.     end;
  195.     
  196.     procedure LForEachSelectedItem( list: ListHandle; proc: LForEachProc; refcon: univ longint );
  197.         var
  198.             c: Cell;
  199.             result: LForEachProcResult;
  200.     begin
  201.         Assert( list <> nil );
  202.         Assert( proc <> nil );
  203.         c.h := 0;
  204.         c.v := 0;
  205.         while LGetSelect(true, c, list) do begin
  206.             result := proc( list, c, refcon );
  207.             case result of
  208.                 FEP_Continue: begin
  209.                     c.v := c.v + 1;
  210.                 end;
  211.                 FEP_Stop: begin
  212.                     leave;
  213.                 end;
  214.                 FEP_Deleted: begin
  215.                     { do nothing }
  216.                 end;
  217.             end;
  218.         end;
  219.     end;
  220.  
  221. end.
  222.